Aminet 30/Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso/Aminet/dev/lang/SmallEiffel.lha/SmallEiffel/lib_se/globals.e

Text File | 1998-12-22 | 13KB | 607 lines

--          This file is part of SmallEiffel The GNU Eiffel Compiler.
--          Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE
--            Dominique COLNET and Suzanne COLLIN - [e-mail]
--                       http://www.loria.fr/SmallEiffel
-- SmallEiffel is  free  software;  you can  redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the Free
-- Software  Foundation;  either  version  2, or (at your option)  any  later
-- version. SmallEiffel is distributed in the hope that it will be useful,but
-- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or  FITNESS FOR A PARTICULAR PURPOSE.   See the GNU General Public License
-- for  more  details.  You  should  have  received a copy of the GNU General
-- Public  License  along  with  SmallEiffel;  see the file COPYING.  If not,
-- write to the  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-- Boston, MA 02111-1307, USA.
--
deferred class GLOBALS
   --
   -- Global Tools for the SmallEiffel system.
   --

inherit UNIQUE_STRING_LIST; FROZEN_STRING_LIST;

feature {NONE} -- Following shared objects are singletons :

   frozen small_eiffel: SMALL_EIFFEL is
      once
     !!Result.make;
      end;

   frozen system_tools: SYSTEM_TOOLS is
      once
     !!Result.make;
      end;

   frozen eiffel_parser : EIFFEL_PARSER is
      once
     !!Result.make;
      end;

   frozen unique_string: UNIQUE_STRING is
      once
     !!Result.make;
      end;

   frozen id_provider: ID_PROVIDER is
      once
     !!Result.make;
      end;

   frozen manifest_string_pool: MANIFEST_STRING_POOL is
      once
     !!Result;
      end;

   frozen manifest_array_pool: MANIFEST_ARRAY_POOL is
      once
     !!Result;
      end;

   frozen once_routine_pool: ONCE_ROUTINE_POOL is
      once
     !!Result;
      end;

   frozen cecil_pool: CECIL_POOL is
      once
     !!Result;
      end;

   frozen parser_buffer: PARSER_BUFFER is
      once
     !!Result.make;
      end;

   frozen address_of_pool: ADDRESS_OF_POOL is
      once
     !!Result;
      end;

   frozen fmt: FMT is
      once
     !!Result.make;
      end;

   frozen short_print: SHORT_PRINT is
      once
     !!Result.make;
      end;

   frozen eh: ERROR_HANDLER is
      once
     !!Result.make
      end;

   frozen echo: ECHO is
      once
     !!Result.make;
      end;

   frozen run_control: RUN_CONTROL is
      once
     !!Result.make;
      end;

   frozen switch_collection: SWITCH_COLLECTION is
      once
      end;

   frozen cpp: C_PRETTY_PRINTER is
      once
     !!Result.make;
      end;

   frozen gc_handler: GC_HANDLER is
      once
     !!Result.make;
      end;

   frozen exceptions_handler: EXCEPTIONS_HANDLER is
      once
     !!Result.make;
      end;

   frozen jvm: JVM is
      once
     !!Result.make;
      end;

   frozen constant_pool: CONSTANT_POOL is
      once
     !!Result;
      end;

   frozen field_info: FIELD_INFO is
      once
     !!Result;
      end;

   frozen code_attribute: CODE_ATTRIBUTE is
      once
     !!Result;
      end;

   frozen method_info: METHOD_INFO is
      once
     !!Result;
      end;

feature {NONE} -- Error messages handling :

   nb_errors: INTEGER is
      do
     Result := eh.nb_errors;
      ensure
     Result >= 0
      end;

   nb_warnings: INTEGER is
      do
     Result := eh.nb_warnings;
      ensure
     Result >= 0
      end;

   warning(p: POSITION; msg: STRING) is
     -- Warning `msg' at position `p'.
      require
     not msg.empty
      do
     eh.add_position(p);
     eh.warning(msg);
      ensure
     nb_warnings = old nb_warnings + 1
      end;

   error(p: POSITION; msg: STRING) is
     -- When error `msg' occurs at position `p'.
      require
     not msg.empty
      do
     eh.add_position(p);
     eh.error(msg);
      ensure
     nb_errors = old nb_errors + 1
      end;

   fatal_error(msg: STRING) is
     -- Should not append but it is better to know :-)
      require
     not msg.empty
      do
     eh.fatal_error(msg);
      end;

feature {NONE} -- Common globals buffers :

   tmp_path: STRING is ".......................................................%
                       %.......................................................";

   tmp_file_read: STD_FILE_READ is
      once
     !!Result.make;
      end;

feature {NONE} -- Globals implicits expressions :

   class_with(str: STRING): BASE_CLASS is
      require
     not str.empty;
      do
     Result := small_eiffel.get_class(str);
      end;

   class_any: BASE_CLASS is
      once
     Result := class_with(us_any);
      end;

   class_general: BASE_CLASS is
      once
     Result := class_with(us_general);
      end;

feature {NONE} -- Globals implicits types :

   type_boolean_ref: TYPE_CLASS is
      local
     boolean_ref: CLASS_NAME;
      once
     !!boolean_ref.make(us_boolean_ref,Void);
     !!Result.make(boolean_ref);
      end;

   type_character_ref: TYPE_CLASS is
      local
     character_ref: CLASS_NAME;
      once
     !!character_ref.make(us_character_ref,Void);
     !!Result.make(character_ref);
      end;

   type_integer_ref: TYPE_CLASS is
      local
     integer_ref: CLASS_NAME;
      once
     !!integer_ref.make(us_integer_ref,Void);
     !!Result.make(integer_ref);
      end;

   type_real_ref: TYPE_CLASS is
      local
     real_ref: CLASS_NAME;
      once
     !!real_ref.make(us_real_ref,Void);
     !!Result.make(real_ref);
      end;

   type_double_ref: TYPE_CLASS is
      local
     double_ref: CLASS_NAME;
      once
     !!double_ref.make(us_double_ref,Void);
     !!Result.make(double_ref);
      end;

   type_pointer_ref: TYPE_CLASS is
      local
     pointer_ref: CLASS_NAME;
      once
     !!pointer_ref.make(us_pointer_ref,Void);
     !!Result.make(pointer_ref);
      end;

   type_boolean: TYPE_BOOLEAN is
      once
     !!Result.make(Void);
      end;

   type_double: TYPE_DOUBLE is
      once
     !!Result.make(Void);
      end;

   type_string: TYPE_STRING is
      once
     !!Result.make(Void);
      end;

   type_any: TYPE_ANY is
      once
     !!Result.make(Void);
      end;

   type_general: TYPE_CLASS is
      once
     !!Result.make(class_with(us_general).base_class_name);
      end;

   type_none: TYPE_NONE is
      once
     !!Result.make(Void);
      end;

   type_pointer: TYPE_POINTER is
      once
     !!Result.make(Void);
      end;

feature {NONE} -- Globals procedures/functions :

   sort_running(run: ARRAY[RUN_CLASS]) is
     -- Sort `run' to put small `id' first.
      require
     run.lower = 1;
     run.upper >= 2;
      local
     min, max, buble: INTEGER;
     moved: BOOLEAN;
      do
     from
        max := run.upper;
        min := 1;
        moved := true;
     until
        not moved
     loop
        moved := false;
        if max - min > 0 then
           from
          buble := min + 1;
           until
          buble > max
           loop
          if run.item(buble - 1).id > run.item(buble).id then
             run.swap(buble - 1,buble);
             moved := true;
          end;
          buble := buble + 1;
           end;
           max := max - 1;
        end;
        if moved and then max - min > 0 then
           from
          moved := false;
          buble := max - 1;
           until
          buble < min
           loop
          if run.item(buble).id > run.item(buble + 1).id then
             run.swap(buble,buble + 1);
             moved := true;
          end;
          buble := buble - 1;
           end;
           min := min + 1;
        end;
     end;
      end;

feature {NONE}

   pos(line, column: INTEGER): POSITION is
      require
     line >= 1;
     column >= 1;
      do
     !!Result.make(line,column);
      end;

feature {NONE}

   no_errors: BOOLEAN is
      do
     Result := nb_errors = 0;
      end;

   code_require, code_ensure: INTEGER is unique;

   character_coding(c: CHARACTER; str: STRING) is
     -- Append in `str' the Eiffel coding of the character (Table
     -- in chapter 25 of ETL, page 423).
     -- When letter notation exists, it is returned in priority :
     --  '%N' gives "%N", '%T' gives "%T", ...
     -- When letter notation does not exists (not in ETL table),
     -- numbered coding is used ("%/1/", "%/2/" etc).
      local
     special: CHARACTER
      do
     inspect
        c
     when '%A' then
        special := 'A';
     when '%B' then
        special := 'B';
     when '%C' then
        special := 'C';
     when '%D' then
        special := 'D';
     when '%F' then
        special := 'F';
     when '%H' then
        special := 'H';
     when '%L' then
        special := 'L';
     when '%N' then
        special := 'N';
     when '%Q' then
        special := 'Q';
     when '%R' then
        special := 'R';
     when '%S' then
        special := 'S';
     when '%T' then
        special := 'T';
     when '%U' then
        special := 'U';
     when '%V' then
        special := 'V';
     when '%%' then
        special := '%%';
     when '%'' then
        special := '%'';
     when '%"' then
        special := '"';
     when '%(' then
        special := '(';
     when '%)' then
        special := ')';
     when '%<' then
        special := '<';
     when '%>' then
        special := '>';
     else
     end;
     str.extend('%%');
     if special = '%U' then
        str.extend('/');
        c.code.append_in(str);
        str.extend('/');
     else
        str.extend(special);
     end;
      end;

feature {NONE}

   runnable(collected: ARRAY[ASSERTION]; ct: TYPE;
        for:RUN_FEATURE): ARRAY[ASSERTION] is
     -- Produce a runnable `collected'.
      require
     collected.lower = 1;
     for /= Void implies ct = for.current_type;
      local
     i: INTEGER;
     a: ASSERTION;
      do
     if not collected.empty then
        from
           Result := collected.twin;
           i := Result.upper;
        until
           i = 0
        loop
           small_eiffel.push(for);
           a := Result.item(i).to_runnable(ct);
           if a = Void then
          error(Result.item(i).start_position,fz_bad_assertion);
           else
          Result.put(a,i);
           end;
           small_eiffel.pop;
           i := i - 1;
        end;
     end;
      end;

feature {NONE}

   sfw_connect(sfw: STD_FILE_WRITE; path: STRING) is
      require
     not sfw.is_connected;
     path /= Void
      do
     sfw.connect_to(path);
     if sfw.is_connected then
        echo.put_string("Writing %"");
        echo.put_string(path);
        echo.put_string("%" file.%N");
     else
        echo.w_put_string("Cannot write file %"");
        echo.w_put_string(path);
        echo.w_put_string(fz_b0);
        die_with_code(exit_failure_code);
     end;
      ensure
     sfw.is_connected
      end;

feature {NONE}

   fatal_error_vtec_2 is
      do
     fatal_error("Expanded class must have no creation procedure,%
              % or only one creation procedure with%
              % no arguments (VTEC.2).");
      end;

feature {NONE} -- Handling of Files Suffix Names :

   eiffel_suffix: STRING is ".e";
     -- Eiffel Source file suffix.

   c_suffix: STRING is ".c";
     -- C files suffix.

   h_suffix: STRING is ".h";
     -- Heading C files suffix.

   o_suffix: STRING is
      do
     Result := system_tools.o_suffix_memory;
      end;

   backup_suffix: STRING is ".bak";
     -- Backup suffix for command `pretty'.

   help_suffix: STRING is ".txt";
     -- Suffix for SmallEiffel On-line Help Files.

   class_suffix: STRING is ".class";

feature {NONE}

   dot_precedence: INTEGER is 12;
     -- The highest precedence value according to ETL.

   atomic_precedence: INTEGER is 13;
     -- Used for atomic elements.

feature {NONE}

   jvm_root_class: STRING is
     -- Fully qualified name for the jvm SmallEiffel object's
     -- added root : "<Package>/<fz_jvm_root>".
      once
     !!Result.make(12);
     Result.copy(jvm.output_name);
     Result.extend('/');
     Result.append(fz_jvm_root);
      end;

   jvm_root_descriptor: STRING is
           -- Descriptor for `jvm_root_class': "L<jvm_root_class>;"
      once
     !!Result.make(12);
     Result.extend('L');
     Result.append(jvm_root_class);
     Result.extend(';');
      end;

feature {NONE}

   append_u1(str: STRING; u1: INTEGER) is
      require
     u1.in_range(0,255);
      do
     str.extend(u1.to_character);
      end;

   append_u2(str: STRING; u2: INTEGER) is
      require
     u2.in_range(0,65536)
      do
     append_u1(str,u2 // 256);
     append_u1(str,u2 \\ 256);
      end;

   append_u4(str: STRING; u4: INTEGER) is
      require
     u4.in_range(0,(2 ^ 31) - 1)
      do
     append_u2(str,u4 // 65536);
     append_u2(str,u4 \\ 65536);
      end;

feature {NONE} -- To build the c_frame_descriptor :

   c_frame_descriptor_local_count: COUNTER is
     -- Current is not in this total.
      once
     !!Result;
      end;

   c_frame_descriptor_format: STRING is
     -- The format to print Current and other locals.
      once
     !!Result.make(512);
      end;

   c_frame_descriptor_locals: STRING is
     -- To initialize field `locals' of `se_dump_stack'.
      once
     !!Result.make(512);
      end;

end -- GLOBALS